home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CU Amiga Super CD-ROM 11
/
CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso
/
cucd
/
programming
/
oberonv4
/
source
/
system
/
v24.mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1996-05-27
|
7KB
|
208 lines
Syntax20b.Scn.Fnt
ParcElems
Alloc
Syntax24b.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10b.Scn.Fnt
FoldElems
Syntax10.Scn.Fnt
Syntax10b.Scn.Fnt
PROCEDURE StartV24*;
VAR text: Texts.Text; beg, end, time: LONGINT; s: Texts.Scanner;
BEGIN Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
IF (s.class = Texts.Char) & (s.c = "^") & (s.line = 0) THEN Oberon.GetSelection(text, beg, end, time);
IF time > 0 THEN Texts.OpenScanner(s, text, beg); Texts.Scan(s) END
END;
LOOP
IF (s.line = 0) & (s.class = Texts.Name) THEN
IF s.s = "even" THEN MR1 := CHR(ORD(MR1) DIV 32 * 32 + 0 + ORD(MR1) MOD 4)
ELSIF s.s = "odd" THEN MR1 := CHR(ORD(MR1) DIV 32 * 32 + 4 + ORD(MR1) MOD 4)
ELSIF s.s = "none" THEN MR1 := CHR(ORD(MR1) DIV 32 * 32 + 16 + ORD(MR1) MOD 4)
ELSIF s.s = "XON" THEN XOFF := 1X
ELSIF s.s = "XOFF" THEN XOFF := 0X
END
ELSIF (s.line = 0) & (s.class = Texts.Int) THEN
IF s.i = 1 THEN MR2 := 7X
ELSIF s.i = 2 THEN MR2 := 0FX
ELSIF s.i = 7 THEN MR1 := CHR(ORD(MR1) DIV 4 * 4 + 2)
ELSIF s.i = 8 THEN MR1 := CHR(ORD(MR1) DIV 4 * 4 + 3)
ELSIF s.i = 1200 THEN CSR := 66X
ELSIF s.i = 2400 THEN CSR := 88X
ELSIF s.i = 4800 THEN CSR := 99X
ELSIF s.i = 9600 THEN CSR := 0BBX
ELSIF s.i = 19200 THEN CSR := 0CCX
END
ELSE EXIT
END;
Texts.Scan(s)
END;
V24.Stop; V24.Send(XOFF); (* flow control *)
V24.Start(CSR, MR1, MR2)
END StartV24;
(* AMIGA *)
MODULE V24; (* RD 31 Dec 95 *)
(* Buffers Recieve, but not Send *)
(* This MODULE always uses the default parameters selected by the Serial Preferences Tool *)
IMPORT SYSTEM, E:=AmigaExec, S:=AmigaSerial, Amiga, O:=Console;
CONST
BuffSize = 1024;
IOExtSerPointer = POINTER TO S.IOExtSer;
SerOpen: BOOLEAN;
SerMP: E.MsgPortPtr;
SerIOPtr: E.MessagePtr;
Error: SHORTINT;
Buffer: ARRAY BuffSize OF CHAR;
BuffEnd, BuffPos: INTEGER;
(* Close Serial Device *)
PROCEDURE CloseDevice;
BEGIN
IF SerOpen THEN
E.CloseDevice(SerIOPtr)
END;
IF SerIOPtr#0 THEN
E.DeleteIORequest(SerIOPtr)
END;
IF SerMP#0 THEN
E.DeleteMsgPort(SerMP)
END;
SerOpen:=FALSE; SerMP:=0; SerIOPtr:=0
END CloseDevice;
(* Open Serial Device *)
PROCEDURE OpenDevice;
BEGIN
SerMP:=E.CreateMsgPort();
IF SerMP#0 THEN
SerIOPtr:=E.CreateIORequest(SerMP, SIZE(S.IOExtSer));
IF SerIOPtr#0 THEN
Error:=E.OpenDevice(S.serialName, 0, SerIOPtr, {});
IF Error=0 THEN SerOpen:=TRUE END
END
END;
IF ~SerOpen THEN CloseDevice() END
END OpenDevice;
(* Get # of available Chars and fill Buffer, if possible *)
PROCEDURE GetAvail();
IOSerPointer: IOExtSerPointer;
NrChars: LONGINT;
r: SHORTINT;
BEGIN
IOSerPointer:=SYSTEM.VAL(IOExtSerPointer, SerIOPtr); (* Get # of available Chars *)
IOSerPointer.command:=S.query;
r:=E.DoIO(SerIOPtr);
NrChars:=IOSerPointer.actual;
IF NrChars=0 THEN (* No Char available *)
BuffPos:=0; BuffEnd:=0
ELSE
IF NrChars>BuffSize THEN NrChars:=BuffSize END; (* Read available Chars *)
IOSerPointer:=SYSTEM.VAL(IOExtSerPointer, SerIOPtr);
IOSerPointer.command:=E.read;
IOSerPointer.length:=NrChars;
IOSerPointer.data:=SYSTEM.ADR(Buffer);
r:=E.DoIO(SerIOPtr);
IF r=0 THEN
BuffPos:=0; BuffEnd:=SHORT(NrChars)
END
END GetAvail;
(* Start the Serial Device *)
PROCEDURE Start*(baud: INTEGER; data, stop: SHORTINT; parity, even: BOOLEAN);
BEGIN
IF ~SerOpen THEN OpenDevice() END;
BuffEnd:=0; BuffPos:=0
END Start;
(* Return # of available Chars *)
PROCEDURE Available*(): INTEGER;
BEGIN
IF SerOpen THEN
IF BuffPos>=BuffEnd THEN GetAvail() END;
RETURN BuffEnd-BuffPos
ELSE
RETURN 0
END Available;
(* Recive on Char, first try Buffer, if empty, use GetAvail *)
PROCEDURE Receive*(VAR x: CHAR);
IOSerPointer: IOExtSerPointer;
r: SHORTINT;
BEGIN
IF SerOpen THEN
IF BuffPos<BuffEnd THEN (* Char in Buffer, RETURN it *)
x:=Buffer[BuffPos];
INC(BuffPos)
ELSE
GetAvail(); (* Try to fill Buffer again *)
IF BuffPos<BuffEnd THEN (* RETURN new CHAR *)
x:=Buffer[BuffPos];
INC(BuffPos)
ELSE (* READ 1 Char from Device *)
IOSerPointer:=SYSTEM.VAL(IOExtSerPointer, SerIOPtr);
IOSerPointer.command:=E.read;
IOSerPointer.length:=1;
IOSerPointer.data:=SYSTEM.ADR(x);
r:=E.DoIO(SerIOPtr)
END
END
ELSE
x:=CHR(0)
END Receive;
(* Send one Char, not buffered *)
PROCEDURE Send*(x: CHAR);
IOSerPointer: IOExtSerPointer;
r: SHORTINT;
BEGIN
IF SerOpen THEN
IOSerPointer:=SYSTEM.VAL(IOExtSerPointer, SerIOPtr);
IOSerPointer.command:=E.write;
IOSerPointer.length:=1;
IOSerPointer.data:=SYSTEM.ADR(x);
r:=E.DoIO(SerIOPtr)
END Send;
(* Break Serial Device *)
PROCEDURE Break*;
VAR l: LONGINT; i: SHORTINT;
BEGIN
IF SerOpen THEN
IF ~E.CheckIO(SerIOPtr) THEN
l:=E.AbortIO(SerIOPtr)
END;
(*i:=E.WaitIO(SerIOPtr);*)
END;
CloseDevice()
END Break;
(* Stop Serial Device *)
PROCEDURE Stop*;
VAR i: SHORTINT;
BEGIN
IF Open THEN
i:=E.WaitIO(SerIOPtr)
END;
CloseDevice()
Break()
END Stop;
(* Open Serial Device *)
PROCEDURE Open*;
BEGIN
IF ~SerOpen THEN
Start(19200, 8, 1, FALSE, TRUE);
IF ~SerOpen THEN
O.Str("Can not open Serial Device"); O.Ln;
END;
END;
END Open;
(*StartV24*)
(* All PROCEDURES setting Serial-Parameters do nothink *)
PROCEDURE FlowCntlOff*;
BEGIN
END FlowCntlOff;
PROCEDURE FlowCntlXOn*;
BEGIN
END FlowCntlXOn;
PROCEDURE FlowCntlCTS*;
BEGIN
END FlowCntlCTS;
PROCEDURE FlowCntlDTR*;
BEGIN
END FlowCntlDTR;
BEGIN
SerOpen:=FALSE; SerMP:=0; SerIOPtr:=0; BuffPos:=0; BuffEnd:=0;
Amiga.TermProcedure(Break)
END V24.